home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 1 Issue 2 / PDCD-1 - Issue 02.iso / _utilities / utilities / 003 / _family / !FamTools / AncGed (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1994-06-07  |  12KB  |  575 lines
  1.  > AncGed
  2. !Version$="1.00 (07 Jun 1994)"
  3.  You may copy this program freely as long as you
  4.  don't charge for it and this notice is retained.
  5.  Denis Howe <dbh@doc.ic.ac.uk> +44 (81) 450 9448
  6. $;" @ ";
  7.  Get input file name from command line
  8.  "OS_GetEnv" 
  9.  Cmd$
  10. Cmd$,"-quit")
  11.  I%=0 
  12.  1,"Can't find arguments!"
  13. Cmd$," ",I%+6)
  14.  IF I%=0 OSCLI "AncGed ADFS::HD.$.Misc.Family.Ancestry.RoyalAnc":QUIT
  15.  I%=0 
  16.  1,"Usage: AncGed <Ancestry file>"
  17. InFile$=
  18. Cmd$,I%+1)
  19. OutFile$=InFile$+"G"
  20. Load(InFile$)
  21. Out(OutFile$)
  22.  ======================================================================
  23. Load(InFile$)
  24.  F%,ext%
  25. (InFile$)
  26.  F%=0 
  27.  1,"Can't read '"+InFile$+"'"
  28. ext%=
  29.  D%+ext%>=
  30. ceiling 
  31.  1,"No room"
  32. ("Load "+InFile$+" "+
  33.  ?D%<>
  34.  D%?1<>
  35.  1,"Not an Ancestry file"
  36. ',N%=
  37. bb(D%+3)  :
  38.  number of basic records
  39. (/M%=
  40. bb(D%+5)  :
  41.  number of marriage records
  42. )4X%=
  43. bb(D%+7)  :
  44.  number of deleted basic records
  45. *7E%=
  46. bb(D%+9)  :
  47.  number of deleted marriage records
  48. Out(OutFile$)
  49.  MODE 0:VDU 14
  50.  26,12
  51. ;N%;" basic records"
  52. ;M%;" marriage records"
  53. ;X%;" deleted basic records"
  54. ;E%;" deleted marriage records"'
  55. (OutFile$)
  56. $+" @ "+
  57.  Write GEDCOM header
  58. #F%,"0 HEAD"
  59. #F%,"1 SOUR Converted from Acorn Archimedes !Ancestry format"
  60. #F%,"2 NAME AncGed"
  61. #F%,"3 VERS "+Version$
  62. #F%,"2 CORP Denis Howe" :
  63.  Author of source software
  64. #F%,"3 ADDR <dbh@doc.ic.ac.uk>"
  65. #F%,"4 CONT 48 Anson Rd., London NW2 3UU, UK"
  66. #F%,"4 PHON +44 (81) 450 9448"
  67. #F%,"2 DATA "+InFile$
  68. #F%,"1 DATE "+
  69. $,5,11)
  70. #F%,"1 GEDC"
  71. #F%,"2 VERS 5.3"
  72.  Process individual and marriage records
  73.  R%=1 
  74. Individual(R%):
  75.  R%=1 
  76. Marriage(R%):
  77.  GEDCOM trailer
  78. #F%,"0 TRLR"
  79.  "SetType "+OutFile$+" GEDCOM"
  80.  "Done"
  81.  =======================================================================
  82.  Process individual record R%
  83. Individual(R%)
  84.  A%,chn%,st$,sx$,SpouseRec%
  85. bad(R%)
  86.  Check for status Z (zapped, ie. deleted)
  87. st(A%):
  88.  st$="Z" 
  89.  "Record: ";R%
  90. #F%,"0 @I"+
  91. R%+"@ INDI"
  92. name$=
  93. Name(A%)
  94.  "Name:   ";name$
  95. #F%,"1 NAME "+name$
  96. sx(A%)
  97.  "Sex:    ";sx$
  98. #F%,"1 SEX "+sx$
  99. dob$=
  100. Date(A%,dobo%)
  101. pob$=
  102. pob(A%)
  103. Print("Birth:  ",dob$)
  104.  dob$>"" 
  105.  pob$>"" 
  106. #F%,"1 BIRT"
  107.  dob$>"" 
  108. #F%,"2 DATE "+dob$
  109. Print("        ",pob$)
  110.  pob$>"" 
  111. #F%,"2 PLAC "+pob$
  112. dod$=
  113. Date(A%,dodo%)
  114. pod$=
  115. pod(A%)
  116.  dob$>"" 
  117.  pod$>"" 
  118. #F%,"1 DEAT"
  119.  dod$>"" 
  120. #F%,"2 DATE "+dod$
  121. Print("Death:  ",dod$)
  122. Print("        ",pod$)
  123.  pod$>"" 
  124. #F%,"2 PLAC "+pod$
  125. mgs%=
  126. mgs(A%) :
  127.  marriages
  128. #F%,"1 NMR "+
  129. nchi%=
  130. kds(A%)
  131. #F%,"1 NCHI "+
  132. nchi%
  133. fmg(A%) :
  134.  1st marr.
  135.  "Marr:   ";mg%
  136. #F%,"1 FAMS @F"+
  137. mg%+"@"
  138.  sx$="M" mg%=
  139. mad(mg%)) 
  140.  mg%=
  141. mad(mg%)) 
  142. ~7pa%=
  143. pa(A%):
  144.  pa%<>&FFFF 
  145.  "Father: ";
  146. RecName(pa%)
  147. 7ma%=
  148. ma(A%):
  149.  pa%<>&FFFF 
  150.  "Mother: ";
  151. RecName(ma%)
  152. famc%=
  153. FamC(pa%,ma%,R%)
  154.  famc% 
  155.  "FamC:   ";famc%
  156. #F%,"1 FAMC @F"+
  157. famc%+"@"
  158.  Other Ancestry fields are converted to NOTEs.
  159.  st$ 
  160.  "S":
  161. "Single"
  162.  "M":
  163. "Married"
  164.  "D":
  165. "Divorced"
  166.  "W":
  167. "Widowed"
  168.  "X":
  169.  Unknown
  170.  1,st$
  171.  ===================================================================
  172.  Process marriage record R%
  173. Marriage(R%)
  174.  MAd%,ch%
  175. MAd%=
  176. mad(R%)
  177.  "Marriage: ";R%
  178. #F%,"0 @F"+
  179. R%+"@ FAM"
  180. husrec%=
  181. hb(MAd%)
  182.  "Husband:  ";
  183. RecName(husrec%)
  184. #F%,"1 HUSB @I"+
  185. husrec%+"@"
  186. wifrec%=
  187. wf(MAd%)
  188.  "Wife:     ";
  189. RecName(wifrec%)
  190. #F%,"1 WIFE @I"+
  191. wifrec%+"@"
  192. ech(MAd%)
  193.   ChAd%=
  194. bad(ch%)
  195.  "Child:    ";
  196. Name(ChAd%)
  197. #F%,"1 CHIL @I"+
  198. ch%+"@"
  199.   ch%=
  200. nys(ChAd%)
  201. dom$=
  202. Date(MAd%,domo%)
  203. Print("        Married: ",dom$)
  204. pom$=
  205. pom(MAd%)
  206. Print("        Place:   ",pom$)
  207.  dom$>"" 
  208.  pom$>"" 
  209. #F%,"1 MARR"
  210.  dom$>"" 
  211. #F%,"2 DATE "+dom$
  212.  pom$>"" 
  213. #F%,"2 PLAC "+pom$
  214. tp(MAd%)
  215.  tp$<>"M" 
  216. "        Type:    ";tp$
  217. doe$=
  218. Date(MAd%,doeo%)
  219. Print("        Ended:   ",doe$)
  220. rfe$=
  221. rfe(MAd%):DvEvTg$=""
  222. "        Reason:  ";rfe$
  223.  rfe$ 
  224.  "HD":r$="Husband died"
  225.  "WD":r$="Wife died"
  226.  "AN":r$="Anulled":DvEvTg$="ANUL"
  227.  "DV":r$="Divorced":DvEvTg$="DIV"
  228.  1,"<"+rfe$+">"
  229.  DvEvTg$>"" 
  230. #F%,"1 "+DvEvTg$
  231.  doe$>"" 
  232. #F%,"2 DATE "+doe$
  233. chn%=
  234. chn(MAd%)
  235.  "Children: ";chn%
  236. #F%,"1 NCHI "+
  237.  ======================================================================
  238. FamC(husrec%,wifrec%,chirec%)
  239.  R%:R%=
  240. Parent(husrec%,hnmo%,chirec%)
  241.  R%=0 R%=
  242. Parent(wifrec%,wnmo%,chirec%)
  243. Parent(parrec%,nmo%,chirec%)
  244.  marrec%,mad%
  245.  parrec%=&FFFF 
  246. marrec%=
  247. bad(parrec%))
  248.  marrec%
  249.   mad%=
  250. mad(marrec%)
  251. ChiOfMar(mad%,chirec%) 
  252. =marrec%
  253.   marrec%=
  254. bb(mad%+nmo%)
  255. ChiOfMar(mad%,chirec%)
  256.  crec%
  257. crec%=
  258. ech(mad%)
  259.  crec%
  260.  crec%=chirec% 
  261.   crec%=
  262. bad(crec%))
  263.  ======================================================================
  264. Print(Head$,Val$)
  265.  Val$>"" 
  266.  Head$+Val$
  267. btab%=1  :
  268.  basic records
  269.  mtab%=2  :
  270.  marriage records
  271. ntab%=3  :
  272.  names
  273. stab%=4  :
  274.  surnames
  275. ttab%=5  :
  276.  titles
  277. ptab%=6  :
  278.  places
  279. wtab%=7  :
  280.  word
  281. itab%=8  :
  282.  integer
  283. etab%=9  :
  284.  extract
  285. 4tables%=9                    :
  286.  Number of tables
  287. 9program%=160000              :
  288.  allowance for program
  289. ;variables%=160000            :
  290.  allowance for variables
  291. 7stack%=10000                 :
  292.  allowance for stack
  293. +program%+variables%  :
  294.  start of data block
  295. AP%=D%+16                     :
  296.  start of table offset storage
  297. 8S%=D%+100                    :
  298.  start of first table
  299. <C%=D%-100                    :
  300.  start of working storage
  301. :L%=40                        :
  302.  Length of basic record
  303. =W%=32                        :
  304.  Length of marriage record
  305.  offsets for basic record
  306. sno% = 0  :
  307.  surname
  308. fno% = 2  :
  309.  forename
  310. bno% = 4  :
  311.  bynames
  312. sxo% = 6  :
  313. sto% = 7  :
  314.  status
  315. tlo% = 8  :
  316.  title
  317. dobo%=10  :
  318.  date of birth
  319. pobo%=15  :
  320.  place of birth
  321. dodo%=17  :
  322.  date of death
  323. podo%=22  :
  324.  place of death
  325. pao% =24  :
  326.  father
  327. mao% =26  :
  328.  mother
  329. sbso%=28  :
  330.  siblings
  331. #neso%=29  :
  332.  next elder sibling
  333. %nyso%=31  :
  334.  next younger sibling
  335. mgso%=33  :
  336.  marriages
  337. fmgo%=34  :
  338.  first marriage
  339. kdso%=36  :
  340.  kids
  341. 'bf1o%=37  :
  342.  basic flag 1 - deleted
  343. bf2o%=38  :
  344.  basic flag 2
  345. bf3o%=39  :
  346.  basic flag 3
  347.  offsets for marriage record
  348. !domo%= 0  :
  349.  date of marriage
  350. %tpo% = 5  :
  351.  type of relationship
  352. (doeo%= 6  :
  353.  date of end of marriage
  354. +rfeo%=11  :
  355.  reason for end of marriage
  356. "pomo%=13  :
  357.  place of marriage
  358. hbo% =15  :
  359.  husband
  360. wfo% =17  :
  361.  wife
  362. chno%=19  :
  363.  children
  364. echo%=20  :
  365.  eldest child
  366. !(hnmo%=22  :
  367.  husband's next marriage
  368. ",hpmo%=24  :
  369.  husband's previous marriage
  370. #%wnmo%=26  :
  371.  wife's next marriage
  372. $)wpmo%=28  :
  373.  wife's previous marriage
  374. % mf1o%=30  :
  375.  marriage flag 1
  376. & mf2o%=31  :
  377.  marriage flag 2
  378. (0hdo%=70  :
  379.  offset for heading in data block
  380.  Initialise table offsets to zero.
  381. +    a%=P%
  382.  J%=1 
  383.  tables%+1:!a%=0:a%+=4:
  384.  Month$(12)
  385. /WMonth$()="","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  386.  ======================================================================
  387.  Name from a record.
  388. RecName(R%)
  389.  R%=&FFFF 
  390. ="None" 
  391. Name(
  392. bad(R%))
  393.  Name at a record address.  Combine first names,
  394.  surname, 'bynames' and title into one string.
  395. Name(Ad%)
  396.  Name$,Nick$,Title$
  397. >$Name$=
  398. fn(Ad%)+" /"+
  399. sn(Ad%)+"/"
  400. ?3Nick$=
  401. bn(Ad%):
  402.  Nick$>"" Name$+=" ("+Nick$+")"
  403. @2Title$=
  404. tl(Ad%):
  405.  Title$>"" Name$+=", "+Title$
  406. =Name$
  407.  Date string from a record address.
  408. Date(ad%,O%)
  409.  date%,code%,d$,r$
  410. date%=ad%!O%
  411.  date%=0 
  412. code%=ad%!(O%+4)
  413. (1E9+date%),8)
  414. d$,2)+
  415. d$,5,2)+
  416. d$,4)
  417. L    r$=""
  418.  I%=1 
  419.  code% 
  420.  256>>I% r$+="?" 
  421.  r$+=
  422. d$,I%,1)
  423. r$,2)+" "+
  424. Month(
  425. r$,3,2))+" "+
  426. r$,4)
  427. Month(N$)
  428.  M%:M%=
  429. =Month$(M%) 
  430.  =====================================================================
  431.  Start address of table t%.  1 <= t% <= tables%+1
  432. tad(t%)=S% + P%!((t%-1)<<2)
  433.  Address of basic record R%.
  434. bad(R%)=S%+(R%-1)*L%
  435.  address of marriage record R%
  436. mad(R%)=
  437. tad(mtab%)+(R%-1)*W%
  438.  peek two-byte number at address a%, MSB first.
  439. bb(a%)=?a%*256+a%?1
  440. head=
  441. tad(tables%+1)
  442. ceiling=
  443. -stack%
  444.  ======================================================================
  445.  Functions to peek basic records
  446. sn(a%)=$(
  447. tad(stab%)+
  448. bb(a%+sno%))   :
  449.  surname
  450. fn(a%)=$(
  451. tad(ntab%)+
  452. bb(a%+fno%))   :
  453.  forenames
  454. bn(a%)=$(
  455. tad(ntab%)+
  456. bb(a%+bno%))   :
  457.  bynames
  458. sx(a%):
  459. c%                         :
  460. c%=a%?sxo%:
  461. st(a%):
  462. c%                         :
  463.  status
  464. c%=a%?sto%:
  465. tl(a%):=$(
  466. tad(ttab%)+
  467. bb(a%+tlo%))  :
  468.  title
  469. dob(a%):=a%!dobo%                      :
  470.  date of birth
  471. yob(a%):=(a%!dobo%)
  472. 10000            :
  473.  year of birth
  474. cob(a%):=a%?(dobo%+4)                  :
  475.  code of birth
  476. pob(a%):=$(
  477. tad(ptab%)+
  478. bb(a%+pobo%)):
  479.  place of birth
  480. dod(a%):=a%!dodo%                      :
  481.  date of death
  482. yod(a%):=(a%!dodo%)
  483. 10000            :
  484.  year of death
  485. cod(a%):=a%?(dodo%+4)                  :
  486.  code of death
  487. pod(a%):=$(
  488. tad(ptab%)+
  489. bb(a%+podo%)):
  490.  place of death
  491. pa(a%):=
  492. bb(a%+pao%)                  :
  493.  rec-father
  494. ma(a%):=
  495. bb(a%+mao%)                  :
  496.  rec-mother
  497. sbs(a%):=a%?sbso%                      :
  498.  siblings
  499. nes(a%):=
  500. bb(a%+neso%)                :
  501.  rec-next elder sib
  502. nys(a%):=
  503. bb(a%+nyso%)                :
  504.  rec-next younger sib
  505. mgs(a%):=a%?mgso%                      :
  506.  marriages
  507. fmg(a%):=
  508. bb(a%+fmgo%)                :
  509.  rec-first marr
  510. kds(a%):=a%?kdso%                      :
  511.  kids
  512. bf1(a%):=a%?bf1o%                      :
  513.  basic rec-flag 1
  514. bf2(a%):=a%?bf2o%                      :
  515.  basic rec-flag 2
  516. bf3(a%):=a%?bf3o%                      :
  517.  basic rec-flag 3
  518.  functions to peek marriage records
  519. dom(a%):=a%!domo%                      :
  520.  date of marr
  521. yom(a%):=(a%!domo%)
  522. 10000            :
  523.  year of marr
  524. com(a%):=a%?(domo%+4)                  :
  525.  code of marr
  526. tp(a%):
  527. c%                         :
  528.  type of relationship
  529. c%=a%?tpo%:
  530. doe(a%):=a%!doeo%                      :
  531.  date of end of marr
  532. yoe(a%):=(a%!doeo%)
  533. 10000            :
  534.  year of end of marr
  535. coe(a%):=a%?(doeo%+4)                  :
  536.  code of end of marr
  537. rfe(a%):
  538. s%,n%,r$
  539. #s%=a%?rfeo%:
  540.  s% r$=
  541.  r$=""
  542.  n%=a%?(rfeo%+1):
  543.  n% r$+=
  544. pom(a%):=$(
  545. tad(ptab%)+
  546. bb(a%+pomo%)):
  547.  place of marr
  548. hb(a%):=
  549. bb(a%+hbo%)                  :
  550.  rec-husband
  551. wf(a%):=
  552. bb(a%+wfo%)                  :
  553.  rec-wife
  554. chn(a%):=a%?(chno%)                    :
  555.  children of this marr
  556. ech(a%):=
  557. bb(a%+echo%)                :
  558.  rec-eldest child
  559. hnm(a%):=
  560. bb(a%+hnmo%)                :
  561.  rec-husband's next marr
  562. hpm(a%):=
  563. bb(a%+hpmo%)                :
  564.  rec-husband's prev marr
  565. wnm(a%):=
  566. bb(a%+wnmo%)                :
  567.  rec-wife's next marr
  568. wpm(a%):=
  569. bb(a%+wpmo%)                :
  570.  rec-wife's prev marr
  571. mf1(a%):=a%?mf1o%                      :
  572.  marriage rec-flag 1
  573. mf2(a%):=a%?mf2o%                      :
  574.  marriage rec-flag 2
  575.